home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / jockdem4.arc / LISTDEM3.PAS < prev    next >
Pascal/Delphi Source File  |  1991-04-28  |  2KB  |  87 lines
  1. Program ListTTT5_Demo_3;
  2.  
  3. { 
  4.   This an example is extension of the programs listdem1.pas and
  5.   listdem2.pas. In this third example, a user hook has been added.
  6. }
  7.  
  8. Uses CRT, DOS, FastTTT5, WinTTT5, ListTTT5;
  9.  
  10. const
  11.     ListWidth = 60;
  12. type
  13.     StrList  = string[ListWidth];
  14.  
  15. var
  16.     MyList   : array[1..30] of StrList;
  17.  
  18.  Procedure Fill_MyList;
  19.  {}
  20.  begin
  21.      MyList[1] := 'Erica';
  22.      MyList[2] := 'Alison';
  23.      MyList[3] := 'Barbara';
  24.      MyList[4] := 'Sarah';
  25.      MyList[5] := 'Katy';
  26.      MyList[6] := 'Janice';
  27.      MyList[7] := 'Susan';
  28.      MyList[8] := 'Serita';
  29.      MyList[9] := 'Anne';
  30.      MyList[10] := 'Michelle';
  31.      MyList[11] := 'Theresa';
  32.      MyList[12] := 'Shirley';
  33.      MyList[13] := 'Sue';
  34.      MyList[14] := 'Marianne';
  35.      MyList[15] := 'Wilma';
  36.      MyList[16] := 'Beatrice';
  37.      MyList[17] := 'Regina';
  38.      MyList[18] := 'Sudofed';
  39.      MyList[19] := 'Trojan';
  40.      MyList[20] := 'Whip';
  41.  end; {of proc Fill_MyList}
  42.  
  43.  
  44.  
  45.  {$F+}
  46.  Procedure Commentary(var Ch:char; HiPick:byte);
  47.  {}
  48.  begin
  49.      If Ch = #188 then  {F2}
  50.      Case HiPick of
  51.      1 : TempMessageBoxCh(2,10,white,blue,1,'Good fun but married',Ch);
  52.      2 : TempMessageBoxCh(2,10,white,blue,1,'Good looking but boring',Ch);
  53.      3 : TempMessageBoxCh(2,10,white,blue,1,'Nice but too shy',Ch);
  54.      4 : TempMessageBoxCh(2,10,white,blue,1,'Gross but rude',Ch);
  55.      5 : TempMessageBoxCh(2,10,white,blue,1,' 10 ',Ch);
  56.      6 : TempMessageBoxCh(2,10,white,blue,1,'Drinks like a horse (!!) ',Ch);
  57.      18: TempMessageBoxCh(2,10,white,blue,1,'For the morning after',Ch);
  58.      19: TempMessageBoxCh(2,10,white,blue,1,'Never leave home without ''em',Ch);
  59.      20: TempMessageBoxCh(2,10,white,blue,1,'You never know',Ch);
  60.      else
  61.          TempMessageBoxCh(2,10,white,blue,1,'No specific knowledge (yet!)',Ch);
  62.      end;
  63.  end; {of proc Commentary}
  64.  {$F-}
  65.  
  66. begin
  67.     Fill_MyList;
  68.     ClrScr;
  69.     with LTTT do
  70.     begin
  71.         Lines := 15;
  72.         Y := 2;
  73.         LeftChar := chr(026);
  74.         RightChar := ' ';
  75.         AllowToggle := false;
  76.     end;
  77.     L_UserHook := @Commentary;
  78.     WriteCenter(25,lightred,black,'Press F2 for a commentary');
  79.     Show_List(MyList,ListWidth,20);
  80.     ClearText(1,1,80,25,white,black);
  81.     WriteAT(1,1,white,black,'Run DemoTTT.exe for the main demo program');
  82.     WriteAT(1,2,white,black,'TechnoJock''s Turbo Toolkit v5.0');
  83.     GotoXY(1,5);
  84. end.
  85.  
  86.  
  87.